home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
User's Choice Windows CD
/
User's Choice Windows CD (CMS Software)(1993).iso
/
win_m_p
/
pwez51.zip
/
DEMO.BAS
next >
Wrap
BASIC Source File
|
1992-04-01
|
66KB
|
1,690 lines
3 '!!!!!!!!!!!! ** [ READ THIS ] ** !!!!!!!! ** [ READ THIS ] !!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!! THIS MODULE WILL NOT OPERATE AS A STAND-ALONE PROGRAM. IT MUST BE !!!
'!!! LOADED WITH MODULE DEMPART2.BAS. DEMO.BAS MUST BE THE MAIN MODULE. !!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'***************************************************************************
'**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES: ****
'***************************************************************************
'**** For QB4.+ unenhanced version use QB4UNEN.QLB ****
'**** For BASIC 7.+ unenhanced version use PDSUNEN.QLB ****
'**** For QB4.50 enhanced version use QBALL45.QLB or QBNER45.QLB ****
'**** For QB4.00/4.00b enhanced version use QBALL40.QLB or QBNER40.QLB ****
'**** For BASIC 7.0 enhanced version use PDSALL70.QLB or PDSNER70.QLB ****
'**** For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB ****
'**** Load QB or QBX with the /L option using the correct library ****
'***************************************************************************
'----------------------------------------------------------------------------
'---------------------- Windows R-E-Z Demonstration -------------------------
'---------------------- CONNECT Software ------------------------------------
'---------------------- Apr. 01, 1992 ---------------------------------------
'----------------------------------------------------------------------------
'---------------------- Copyright 1988,1989,1990,1991,1992 ------------------
'---------------------- By: CONNECT Software --------------------------------
'---------------------- All rights reserved ---------------------------------
'----------------------------------------------------------------------------
' **** VER 5.10 ------- LAST UPDATE ------- 04/01/1992 ****
'****************************************************************************
DECLARE SUB B4SCRL (EXIT$, MARK$)
DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
DECLARE SUB CHNGWIND (W%)
DECLARE SUB CLRWIND ()
DECLARE SUB DELWIND (W%)
DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
DECLARE SUB DOSOUND ()
DECLARE SUB FINDPATH (PATH$)
DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, ATTR%, BORDER%)
DECLARE SUB GETDISK (DR%)
DECLARE SUB INFOFIXED (FIXED$)
DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
DECLARE SUB INPTINIT (DTYPE%, ISDOT%, INPTEXIT$)
DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, ATTR%, RESTRICT$, RTRN$, RK%, BRD%)
DECLARE FUNCTION KEYMOUSE% ()
DECLARE SUB LINEW (ROW%, TYP%)
DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
DECLARE FUNCTION MARKED% (RTRN$, START%)
DECLARE SUB MBUTTONS (LBUTTON%, RBUTTON%)
DECLARE SUB MOUSEON (ONFLAF%)
DECLARE SUB MULTINPT (SCRN%, FLD%, EXIT$, AUTOEXIT%, RKEY%, RTRN$())
DECLARE SUB NEWCOLOR (ATTR%)
DECLARE SUB PRINTINFO (I$)
DECLARE SUB PRINTW (TEXT$, TR%, LC%)
DECLARE SUB PULLDOWN (INFO$(), A%, B%, EXIT$, RKEY%, ATTR%, HATTR%, BORDER%)
DECLARE SUB RESAVE ()
DECLARE SUB RSTRINFO (DELFLAG%)
DECLARE SUB RSTRINPT (DELFLAG%)
DECLARE SUB RSTRPULL (RSTRMBAR%)
DECLARE SUB RSTRWIND (W%, DELFLAG%)
DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
DECLARE SUB SCRLWIND (LIST$(), INFO$(), TOPLINE$, ENTRIES%, RTRN$, RTRN%, LI%, FC%, RKEY%, HIATTR%)
DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
DECLARE SUB SETINPT (SCRN%, WD%, EXIT$, INPT%(), INPT$(), BACKCOL%)
DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
DECLARE SUB SETSCRL (ARROW%, NOHI%, TAGCOLOR%)
DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%)
DECLARE FUNCTION WAVAIL% (W%)
DECLARE SUB WINDSTATUS ()
'***************************************************************************
DECLARE SUB SOUNDDEMO (WIND%)
DECLARE SUB COLORDEMO (WIND%)
DECLARE SUB PRINTDEMO ()
DECLARE SUB PRINTSPEED (WIND%)
DECLARE SUB SETPARAMETERS ()
DECLARE SUB INPUTWINDOWDEMO ()
DECLARE SUB MULTINPUTDEMO2 ()
DECLARE SUB MULTINPUTDEMO1 ()
DECLARE SUB SETDATEDEMO ()
DECLARE SUB SCROLLDEMO (W%)
DECLARE SUB WINDOWDEMO ()
DECLARE SUB GETANSDEMO ()
DECLARE FUNCTION COL% (C%)
'---------- MUST BE IN ANY MODULE USING "FINDDIR" DIRECTORY ROUTINE --------
TYPE DIREC
SIZE AS LONG ' SIZE
DATE AS STRING * 10 ' DATE
TIME AS STRING * 6 ' TIME
ATTR AS INTEGER ' ATTRIBUTE
END TYPE
COMMON SHARED /DIRECTORY/ DIREC$(), DIRINFO() AS DIREC
DIM SHARED DEMOATTR%, DFORMAT%, DECPOINT%, COLCHOICE%, LOCHOICE%
DIM SHARED FAST%, SND%, SHADCOL%, NOHI%, SCROLLARROW%
'--------------------------- DIMENSION ARRAYS -------------------------------
DIM SHARED CHNGRTRN$(11) ' FOR "CHANGE" MULTINPT
CHNGRTRN$(8) = "Find and Verify"
CHNGRTRN$(9) = "Change All"
CHNGRTRN$(10) = "Cancel"
CHNGRTRN$(11) = "Help"
CHNGRTRN$(5) = CHR$(4)
DIM SHARED DUMMY$(0 TO 0) ' NEEDED BY SCRLWIND ROUTINE
DIM SHARED MRTRN1$(20), MRTRN2$(10) ' FOR MULTI-FIELD INPUT DEMO
DIM SHARED COLCHOICE$(4), LOCHOICE$(4) ' " "
MRTRN1$(5) = "RED" ' # 1 MULTI-FIELD INPUT SCREEN
MRTRN1$(6) = "NORTH" ' "
COLCHOICE$(1) = "RED" ' "
COLCHOICE$(2) = "PURPLE" ' "
COLCHOICE$(3) = "YELLOW" ' "
COLCHOICE$(4) = "GREEN" ' "
LOCHOICE$(1) = "NORTH" ' "
LOCHOICE$(2) = "SOUTH" ' "
LOCHOICE$(3) = "EAST" ' "
LOCHOICE$(4) = "WEST" ' "
COLCHOICE% = 1: LOCHOICE% = 1 ' "
MRTRN2$(1) = "CONNECT SOFTWARE" ' # 2 MULTI-FIELD INPUT SCREEN
MRTRN2$(2) = "6192 FAWN MEADOW" ' "
MRTRN2$(3) = "FARMINGTON, NY" ' "
MRTRN2$(4) = "14425" ' "
MRTRN2$(6) = "123,1" ' "
MRTRN2$(7) = "123,12" ' "
MRTRN2$(8) = "123,123" ' "
DIM LAN$(4), DISK$(2), ORDER$(19) ' FOR ORDER FORM
LAN$(1) = "QuickBASIC 4.5" ' "
LAN$(2) = "QuickBASIC 4.00/.00b" ' "
LAN$(3) = "BASIC 7.0 - PDS" ' "
LAN$(4) = "BASIC 7.1 - PDS" ' "
LAN% = 1: ORDER$(9) = LAN$(1) ' "
DISK$(1) = "5.25 inch - 360K" ' "
DISK$(2) = "3.5 inch - 720K" ' "
DSIZE% = 1: ORDER$(10) = DISK$(1) ' "
'------ ARRAY REPRESENTING ALLOWABLE DATE FORMATS FOR INPUT ROUTINES --------
DIM SHARED DATETYPE$(5)
DATETYPE$(1) = "mm-dd-yyyy"
DATETYPE$(2) = "mm/dd/yyyy"
DATETYPE$(3) = "dd-mm-yyyy"
DATETYPE$(4) = "dd/mm/yyyy"
DATETYPE$(5) = "dd.mm.yyyy"
'----------------------------------------------------------------------------
REALSTART:
PREFLAG% = 1: A% = 15
ON ERROR GOTO DISKERROR
FINDPATH PATH$ ' FIND PRESENT DISK AND PATH
PREFLAG% = 0
ON ERROR GOTO 0
MOUSEON (1) ' TURN THE MOUSE ON
MBUTTONS 13, 27 ' LEFT BUTTON = ESC / RIGHT = RETURN
WIDTH 80
CLS
'--------------------- SET DATA FOR SCROLL WINDOW DEMO ----------------------
DIM SHARED SCROLL$(14) ' READ DATA FOR SCROLL WINDOW DEMO
FOR X% = 1 TO 14 ' "
READ SCROLL$(X%) ' "
NEXT ' "
'DATA FOR SCROLL WINDOW DEMO
DATA This is a sample of a scroll window.
DATA The A@RROW keys or different colored
DATA letter can be pressed to make a sel-
DATA ection. REGULAR scroll windows exit
DATA when ENTER is pressed. AUTO-EXIT
DATA scroll windows exit if the letter
DATA pressed is found. END / HOME / PGUP
DATA and PGDN keys respond as ex@pected.
DATA MARK scroll windows mark or unmark
DATA items in the window with the "+"
DATA or "-" keys. The PRINT k@ey or the
DATA SPACE B@AR marks or unmarks all
DATA items. Press ECS to return to the
DATA pulldown@ menu.
'-------------- SET DATA FOR VIRTUAL SCROLL WINDOW DEMO ---------------------
DIM SHARED ADDRESS$(1 TO 10)
FOR X% = 1 TO 10 ' READ DATA FOR VIRTUAL SCROLL WINDOW DEMO
READ ADDRESS$(X%)
NEXT
'DATA FOR VIRTUAL SCROLL WINDOW DEMO
DATA CONNECT Software 6192 Fawn Meadow Farmington NY 14425
DATA Dell Computer Corp 9505 Arboretum Blvd Austin TX 78759
DATA Micro Warehouse 1690 Oak St Lakewood NJ 08701
DATA ZEOS 530 Fifth Ave NW St Paul MN 55112
DATA Microsoft Press 21919 20th Ave SE Bothell WA 95041
DATA Central Point Software Greenbrier Pkwy Oregon OR 97006
DATA Eastman Kodak Corp 343 State St Rochester NY 14650
DATA National Instruments 6504 Bridge Pt Pkwy Austin TX 73730
DATA Gateway Computers 610 Gateway Dr N Souix City SD 57049
DATA Microsoft Corporation One Microsoft Way Redmond VA 98052
'-------------------- SET DATA FOR PULLDOWN WINDOWS -----------------------
B% = 200
REDIM PWIND$(B%) ' READ DATA FOR
' PULLDOWN MENUBAR AND
WHILE PWIND$(TEMP%) <> "ENDPULL" ' PULLDOWN WINDOWS.
TEMP% = TEMP% + 1
READ PWIND$(TEMP%)
WEND
'PULLDOWN WINDOW #1
DATA Windows, Scroll - Get Answer and more : 'MENUBAR & INFOLINE
' ** NOTE: IF INFO-LINE IS NOT USED THIS WOULD BE THE FIRST DATA LINE:
' DATA Windows,
DATA Window Management System (F1), Get answer windows (F2) : 'WINDOW #1 SELECTIONS
DATA Scroll windows ,-, Ex@it, ***
'PULLDOWN WINDOW #2
DATA Input, Single and Multi-field Input : 'MENUBAR & INFOLINE
DATA Select date format : 'WINDOW'S ITEMS
DATA Multi-field input, Look familiar?
DATA Input window, ***
'PULLDOWN WINDOW #3
DATA Print,Print in windows. : 'MENUBAR & INFOLINE
DATA Print in M@ultiple windows, - : 'WINDOW'S ITEMS
DATA Slow print ( Eliminates screen snow. )
DATA Fast print,***
'PULLDOWN WINDOW #4
DATA Directory,Several Features : 'MENUBAR & INFOLINE
DATA Directory routines,*** : 'WINDOW'S ITEMS
'PULLDOWN WINDOW #5
DATA Color,Set Display Type : 'MENUBAR & INFOLINE
DATA Black and white,Color : 'WINDOW'S ITEMS
DATA No hi-intensity (Black & white),***
'PULLDOWN WINDOW #6
DATA Sound,Set sound : 'MENUBAR & INFOLINE
DATA Beep,Click,No sound,*** : 'WINDOW'S ITEMS
'PULLDOWN WINDOW #7
DATA Order Me,*** Important!!! *** : 'MENUBAR & INFOLINE
DATA Make an order form,*** : 'WINDOW'S ITEMS
DATA ENDPULL : 'END OF PULLDOWN DATA
SETPULL 2, 9, 60, PWIND$() ' SET UP PULLDOWN WINDOWS
ERASE PWIND$ ' ERASE TEMPORARY ARRAY HOLD-
' ING PULLDOWN WINDOW DATA.
'------------- SET DATA FOR INFO-LINE FOR PULLDOWN WINDOWS ------------------
' ** NOTE: THIS IS NOT REQUIRED IF INFO-LINE IS NOT USED
DIM SHARED PULLINFO$(21) ' INFO-LINE DATA
FOR X% = 1 TO 21 ' READ DATA FOR EACH PULLDOWN
READ PULLINFO$(X%) ' WINDOW'S INFO-LINE
NEXT
'INFO-LINE DATA FOR PULLDOWN WINDOW #1
DATA "Make, save and restore windows.", Get a single key user response.
DATA Several types of scroll windows.,,End demonstration.
'INFO-LINE DATA FOR PULLDOWN WINDOW #2
DATA Set date format for input routines., Two sample multi-field input screens.
DATA Multi-field versatility., Variations of single field input windows.
'INFO-LINE DATA FOR PULLDOWN WINDOW #3
DATA Displays print features.,, Required by certain CGA adaptors.
DATA "Use with all VGA, EGA, MONO and most CGA adaptors."
'INFO-LINE DATA FOR PULLDOWN WINDOW #4
DATA Several useful directory routines.
'INFO-LINE DATA FOR PULLDOWN WINDOW #5
DATA Use with MONO monitors., Use with color monitors., Use with LCD displays.
'INFO-LINE DATA FOR PULLDOWN WINDOW #6
DATA Sound for all routines., Sound for all routines., Sound for all routines.
'INFO-LINE DATA FOR PULLDOWN WINDOW #7
DATA Make an order form for WINDOWS R-E-Z.....
DIM SHARED SUBSCROLL$(5)
SUBSCROLL$(1) = "Regular Scroll window"
SUBSCROLL$(2) = "Auto-exit Scroll window"
SUBSCROLL$(3) = "Mark Scroll window"
SUBSCROLL$(4) = "Virtual Scroll window"
SUBSCROLL$(5) = "List virtual scroll window"
'--------------- CALL SET UP ROUTINE FOR FIRST INPUT SCREEN -----------------
A% = 150: REDIM INPT%(A%) ' INPT%() AND INPT$ HOLD DATA
A% = 25: REDIM INPT$(A%) ' FOR FIELDS
Y% = 1: FLD% = 1
DO ' READ THE DATA FOR THE MULT-FIELD
READ INPT%(Y%) ' INPUT ROUTINE.
IF INPT%(Y%) = 9999 THEN EXIT DO
Y% = Y% + 1
FOR XX% = 1 TO 5
READ INPT%(Y%)
Y% = Y% + 1
NEXT
READ INPT$(FLD%)
FLD% = FLD% + 1
LOOP
' DATA FOR EACH FIELD
DATA 0,6,5,10,15,99,""
DATA 10,8,5,10,15,99,""
DATA 1,6,20,10,15,99,""
DATA 2,6,35,10,15,99,""
DATA 30007,6,58,12,15,99,""
DATA 30007,8,58,12,15,99,""
DATA 17,11,5,20,15,99,""
DATA 27,11,31,20,15,99,""
DATA 7,11,55,20,15,99,""
DATA 1017,16,22,1,15,99,"MF"
DATA 1017,16,38,1,15,99,"YN"
DATA 1010,16,60,3,15,99,""
DATA 1010,16,64,2,15,99,""
DATA 1010,16,67,4,15,99,""
DATA 21000,21,23,6,15,99,""
DATA 21000,21,38,6,15,99,""
DATA 100,21,53,7,15,99,""
DATA 9999
SETINPT 1, 80, "012", INPT%(), INPT$(), 0 ' SET UP MULTI-INPUT SCREEN #1
ERASE INPT%, INPT$ ' GET THE MEMORY BACK
' -------- READ DATA FOR CHANGE INPUT SCREEN AND SET UP SAME ---------------
A% = 200: DIM INPT%(A%) ' DIM ARRAYS TO HOLD DATA
B% = 20: DIM INPT$(B%) ' FOR EACH FIELD
FLD% = 0: B% = 1 ' READ THE DATA FOR THE
DO ' MULT-FIELD INPUT ROUTINE.
FLD% = FLD% + 1
READ INPT%(FLD%)
IF INPT%(FLD%) = 9999 THEN EXIT DO
FOR X% = 1 TO 5
FLD% = FLD% + 1
READ INPT%(FLD%)
NEXT
READ INPT$(B%): B% = B% + 1
LOOP
' DATA FOR EACH FIELD
DATA 10007,8,26,41,112,99,"" : 'Field 1 = Find What:
DATA 10007,11,26,41,112,99,"" : 'Field 2 = Change To:
DATA 30007,14,14,1,112,99,"" : 'Field 3 = Match Upper/Lowercase
DATA 30007,15,14,1,112,99,"" : 'Field 4 = Whole Word
DATA 30007,14,46,1,112,99,"" : 'Field 5 = Active Window
DATA 30007,15,46,1,112,99,"" : 'Field 6 = Current Module
DATA 30007,16,46,1,112,99,"" : 'Field 7 = All Modules
DATA 30007,19,15,15,112,99,"" : 'Field 8 = Find and Verify
DATA 30007,19,35,10,112,99,"" : 'Field 8 = Change All
DATA 30007,19,50,6,112,99,"" : 'Field 10 = Cancel
DATA 30007,19,61,4,112,99,"" : 'Field 11 = Help
DATA 9999
SETINPT 3, 80, "E", INPT%(), INPT$(), 0 ' SET UP MULTI-FIELD INPUT - SCREEN 3
ERASE INPT%, INPT$ ' GET MEMORY BACK
'--------- READ DATA FOR THE ORDER FORM INPUT SCREEN AND SET UP SAME -------
A% = 151: B% = 25
REDIM INPT%(A%), INPT$(B%)
Y% = 1: FLD% = 1
DO
READ INPT%(Y%)
IF INPT%(Y%) = 9999 THEN EXIT DO
Y% = Y% + 1
FOR XX% = 1 TO 5
READ INPT%(Y%)
Y% = Y% + 1
NEXT
READ INPT$(FLD%)
FLD% = FLD% + 1
LOOP
'***** FIELD DATA FOR ORDER FORM ******
DATA 10007,5,14,32,15,99,""
DATA 10007,7,14,32,15,99,""
DATA 10007,9,14,32,15,99,""
DATA 10007,11,14,32,15,99,""
DATA 10010,13,14,5,15,99,""
DATA 10008,5,56,10,15,99,""
DATA 10017,7,69,1,15,99,"YN"
DATA 10000,9,69,5,15,99,""
DATA 30007, 15, 25, 20, 15, 99, ""
DATA 30007,15,58,20,15,99,""
DATA 11017,17,33,1,15,99,"YN"
DATA 10007,22,24,20,15,99,"1234567890 "
DATA 10007,22,63,5,15,99,"1234567890/"
DATA 9999
SETINPT 4, 80, "10", INPT%(), INPT$(), 0 ' SET UP MULTI-INPUT SCREEN #4 AND
ERASE INPT%, INPT$ ' ERASE TEMPORARY ARRAYS
'------------------ WINDOW AND INPUT INITIALIZATION -------------------------
FAST% = 1 ' FAST PRINT
SND% = 1 ' "CLICK" SOUND
SHADCOL% = 7 ' BLACK/WHITE WINDOW SHADOWS
NOHI% = 0 ' HI-INTENSITY ON
SCROLLARROW% = 1 ' SCROLL ARROW ON
CALL SETPARAMETERS ' INITIALIZE WINDOW ROUTINE'S PARAMETERS
DECPOINT% = 1 ' USE A PERIOD AS DECIMAL DESIGNATOR
DATETYPE$ = "mm-dd-yyyy" ' REPRESENTS DATE FORMAT #1
DFORMAT% = 1 ' DATE FORMAT #1 = mm-dd-yyyy
CALL INPTINIT(DFORMAT%, DECPOINT%, "")
'----------------------------- INTRODUCTION SCREEN --------------------------
PREINTRO:
IF SHADCOL% = 7 THEN A% = 112 ELSE A% = 116
MAKEWIND 0, "@WINDOWS R-E-Z Version 5.10 --- 04/01/1992", 1, 1, 80, 25, A%, 102
FOR XX% = 1 TO 21 STEP 2
PRINTW "WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z", XX%, 2
IF XX% <> 21 THEN PRINTW STRING$(76, 176), XX% + 1, 2
NEXT
IF INTROPASS% = 1 THEN GOTO PREMAIN.MENU
MAKEWIND 2, "@*** New for Version 5.10 ***", 100, 100, 65, 18, 15, 111
PRINTW "- User defineable exit keys in SCROLL and PULLDOWN windows.", 2, 2
PRINTW "- Extendable SCROLL windows allow scrolling large data files.", 3, 2
PRINTW "- Increased versatility in GET ANSWER routine.", 4, 2
LINEW 6, 2
PRINTW "NOTE: THIS DEMONSTRATION WAS WRITTEN IN IT'S ENTIRETY WITH", 8, 100
PRINTW " QB/QBX AND WITH ROUTINES PROVIDED WITH WINDOWS R-E-Z.", 9, 100
LINEW 11, 2
ONE:
ANS$ = ""
GETANS "Color or Monochrome? (C/M)", "CM", ANS$, 18, 100, 143, 12
IF ANS$ = CHR$(27) THEN GOTO ONE
IF ANS$ = "M" THEN
DEMOATTR% = 112
SHADCOL% = 7
ELSE
CHNGPULL 5, 1, 0
DEMOATTR% = 0
SHADCOL% = 8
END IF
CALL SETPARAMETERS
RSTRWIND 2, 1
INTROPASS% = 1: GOTO PREINTRO
'----------------- SET DATA FOR SECOND MULTI-FIELD INPUT SCREEN -------------
PREMAIN.MENU:
'--------------- CALL SET UP ROUTINE FOR SECOND INPUT SCREEN ---------------
RESTORE PREMAIN.MENU
A% = 120: REDIM INPT%(A%) ' INPT%() AND INPT$ HOLD DATA
A% = 20: REDIM INPT$(A%) ' FOR FIELDS
Y% = 1: FLD% = 1: z% = 112
DO
READ INPT%(Y%)
IF INPT%(Y%) = 9999 THEN EXIT DO
Y% = Y% + 1
FOR XX% = 1 TO 5
READ INPT%(Y%)
Y% = Y% + 1
NEXT
READ INPT$(FLD%)
FLD% = FLD% + 1
LOOP
'***** DATA FOR SECOND MULTI-FIELD INPUT SCREEN *****
DATA 10007,9,25,40,112,99,""
DATA 10007,10,25,30,112,99,""
DATA 10007,11,25,30,112,99,""
DATA 10010,11,56,5,112,99,""
DATA 10008,13,27,10,112,99,""
DATA 10001,16,36,8,112,99,""
DATA 10002,16,53,8,112,99,""
DATA 10003,16,70,8,112,99,""
IF DEMOATTR% = 0 THEN
FOR XX% = 5 TO 65 STEP 6
INPT%(XX%) = 71
NEXT
END IF
DATA 9999
SETINPT 2, 80, "120", INPT%(), INPT$(), 15 ' SET UP MULTI-INPUT SCREEN #2 AND
ERASE INPT%, INPT$
IF DEMOATTR% = 112 THEN INFOATTR% = 15 ELSE INFOATTR% = 31
INFOLINE 24, 2, 78, INFOATTR%
'-------------- MAIN MENU WINDOW ---- USES PULLDOWN ROUTINE -----------------
MAIN.MENU:
A% = COL%(111)
MAKEWIND 2, "@WINDOWS R-E-Z", 4, 50, 25, 7, A%, 111
PRINTW "Version 5.10", 1, 100
PRINTW "CONNECT Software", 2, 100
PRINTW "Apr. 1, 1992", 3, 100
MAKEWIND 1, "@***** Instructions *****", 13, 100, 75, 10, A%, 111
PRINTW "To demonstrate most of the features included with WINDOW R-E-Z use the", 1, 2
PRINTW "PULLDOWN WINDOWS. Use the arrow keys, mouse, or press the appropriate", 2, 2
PRINTW "letter to make a selection. The left mouse botton is set to ENTER and", 3, 2
PRINTW "the right button is set to ESC. WINDOWS R-E-Z can re-define the but-", 4, 2
PRINTW "tons. Instuctions for many of the routines are printed on the info-", 5, 2
PRINTW "line at the bottom of the display...", 6, 2
HATTR% = 124
A% = COL%(113): IF A% = 15 THEN A% = 112: HATTR% = 127
PULL:
INFOFIXED " Demonstration: "
PULLDOWN PULLINFO$(), BAR%, WIND%, "012", RKEY%, A%, HATTR%, 11' PULLDOWN WINDOWS
INFOFIXED ""
IF RKEY% = 1 THEN BAR% = 1: WIND% = 1
IF RKEY% = 2 THEN BAR% = 1: WIND% = 2
IF (BAR% = 1 AND WIND% = 3) OR (BAR% = 1 AND WIND% = 5) THEN
'NOTHING
ELSE ' NOT SCROLL WINDOW DEMO OR EXIT
RSTRPULL 1 ' RESTORE AREA UNDER PULLDOWN WINDOW.
RSTRWIND 2, 1 ' RESTORE "CONNECT SOFTWARE" WINDOW.
RSTRWIND 1, 1 ' RESTORE PULLDOWN INSTRUCTION WINDOW.
END IF
SELECT CASE BAR%
'------------------ "WINDOWS" OPTION FROM MENUBAR --------------------------
CASE 1
SELECT CASE WIND%
CASE 1 ' WINDOW MANAGEMENT SYSTEM
CALL WINDOWDEMO
CASE 2 ' GET ANSWER DEMO
CALL GETANSDEMO
CASE 3 ' SCROLL WINDOW DEMO
CALL SCROLLDEMO(WASESC%)
IF WASESC% = 1 THEN GOTO PULL ' ESC EXITED SCROLL DEMO
' RE-ENTER PULLDOWN WITH PULLDOWN
' WINDOW 1 ACTIVE.
CASE 5: ' EXIT WAS SELECTED
PRINTINFO ("Press Y to quit or N to continue. Press ENTER to accept...")
ANS$ = "N"
CALL GETANS("Quit!! Are you sure? (Y/N) ", "YN", ANS$, 14, 100, 1240, 11)
IF ANS$ = "Y" THEN CLS : END ELSE RSTRPULL 0: GOTO PULL
CASE ELSE
END SELECT
'--------------------- "INPUT" OPTION FROM MENUBAR--------------------------
CASE 2 ' INPUT ROUTINES
SELECT CASE WIND%
CASE 1 ' DATE FORMAT
CALL SETDATEDEMO
CASE 2 ' MULTI-FIELD INPUT
CALL MULTINPUTDEMO1
CASE 3 ' "CHANGE" MULTI-FIELD INPUT
CALL MULTINPUTDEMO2
CASE 4 'INPUT WINDOW DEMO
CALL INPUTWINDOWDEMO
CASE ELSE
END SELECT
'----------------------- "PRINT" OPTION FROM MENUBAR -----------------------
CASE 3 'PRINT IN A WINDOW
SELECT CASE WIND%
CASE 1
CALL PRINTDEMO ' PRINT IN MULTIPE WINDOWS
CASE 3, 4
CALL PRINTSPEED(WIND%) ' FAST OR SLOW PRINT
CASE ELSE
END SELECT
'----------------------- "DIRECTORY" OPTION FROM MENUBAR ------------------
CASE 4
RSTRINFO 0 ' RESTORE AREA UNDER THE INFOLINE - KEEP ACTIVE.
A% = COL%(23) ' COLOR WILL BE BLUE OR B/W.
' MAKE AND PRINT IN WINDOW 10.
MAKEWIND 10, "@**** Directory Demonstration ****", 3, 100, 70, 10, A%, 111
PRINTW "Directory routines permit files from any path to be placed in an", 1, 100
PRINTW "array. All, or selected files, can be found. Wildcards (*?) are", 2, 100
PRINTW "permitted. Searches can include files with any combination of", 3, 100
PRINTW "attributes. To suppliment functions included in QuickBASIC rout-", 4, 100
PRINTW "ines to find disk size, free disk space, the current drive and", 5, 100
PRINTW "path are included.", 6, 3
GETANS "Press any key.....", "", "", 15, 100, A% + 128, 11 'ANY KEY
RSTRWIND 10, 1 ' DELETE WINDOW # 10
DISKINST:
PATH2$ = PATH$ ' PATH$ IS SHARED VARIABLE AND HOLDS
' THE CURRENT PATH.
'GET THE PATH FOR THE DIRECTORY SEARCH VIA CALL TO INPTWIND.
PRINTINFO " Input the path for the directory search."
INPTWIND "@PATH: FORMAT = DRIVE:\DIRECTORY\....( WILDCARDS PERMITTED )", "U", 100, 100, 63, A%, "1234567890QWERTYUIOPLKJHGFDSAZXCVBNM\:?*_.", PATH2$, RK%, 111
RSTRINPT 1 ' RESTORE AREA UNDER INPUT WINDOW & DELETE
IF RK% = 27 THEN GOTO DONEDIR ' ESC WAS PRESSED
IF PATH2$ <> "" THEN ' PATH$ IS NOT NULL.
PATH$ = PATH2$
ELSE ' PATH$ = ""
DOSOUND
GOTO OVER
END IF
' GET THE FILE ATTRIBUTES FOR THE DIRECTORY SEARCH. PUT IN TYPE$
MAKEWIND 10, "@File attributes....", 3, 100, 45, 11, A%, 111
PRINTW "A - archived", 1, 6
PRINTW "H - hidden", 2, 6
PRINTW "R - read only", 3, 6
PRINTW "S - system", 4, 6
PRINTW "D - sub-directory", 5, 6
PRINTW "O - other - no attribute", 6, 6
PRINTW "V - volumn - must be root directory!", 7, 6
PRINTINFO " Input the attributes for the files to include in the directory search."
TYPE$ = ""
INPTWIND " FILE ATTRIBUTES (A/H/R/S/O/D/V):", "U", 16, 100, 7, A%, "AHRSODV", TYPE$, RK%, 111
RSTRINPT 1 ' RESTORE AREA UNDER INPUT WINDOW & DELETE.
RSTRWIND 10, 1 ' RESTORE WINDOW # 10.
IF RK% = 27 THEN GOTO DONEDIR ' ESC EXITED INPTWIND.
IF TYPE$ = "" GOTO OVER ' NULL ENTRY
IF MID$(PATH$, 2, 1) = ":" THEN ' DRIVE WAS SPECIFIED
DR% = ASC(UCASE$(PATH$)) - 64
ELSE ' DRIVE NOT SPECIFIED - USE CURRENT DRIVE.
CALL GETDISK(DR%): PATH$ = CHR$(DR% + 64) + ":" + PATH$
END IF
ON ERROR GOTO DISKERROR ' ALWAYS TRAP FOR ERRORS WHEN
' ACESSING THE DISK.
FINDDIR PATH$, "D", F% ' IS PATH$ A DIRECTORY?
IF F% = 1 THEN PATH$ = PATH$ + "\*.*" 'IF DIRECTORY FIND ALL FILES
' FINDIR PUTS DIRECTORY IN DIREC$(). ADD "L" TO TYPE$ FOR LONG DIR SEARCH.
' F% WILL HOLD THE NUMBER OF FILES FOUND.
FINDDIR PATH$, TYPE$ + "L", F%
' DISKSIZE GETS DISK SIZE IN BYTES AND FREE BYTES.
DISKSIZE DR%, SIZE&, FREE&
ON ERROR GOTO 0
' RESTORE WINDOW 10. MAKE A NEW WINDOW 10 AND PRINT THE DISK SIZE, FREE
' BYTES AND FILES ATTRIBUTES INCLUDED IN THE DIRECTORY SEARCH.
RSTRWIND 10, 1
MAKEWIND 10, "@PATH: " + PATH$, 3, 100, 74, 17, A%, 111
PRINTW "DISK SIZE =" + STR$(SIZE&) + " BYTES", 10, 100
PRINTW "BYTES FREE =" + STR$(FREE&) + " BYTES", 11, 100
PRINTW "FILE ATTRIBUTES: " + TYPE$, 12, 100
IF F% = 0 THEN 'NO DIRECTORY ENTRIES
RSTRINFO 0
A% = A% + 128
ANS$ = ""
GETANS "NO ENTRIES. CONTINUE... (Y/N)?", "YN", ANS$, 21, 100, A%, 11
A% = A% - 128
RSTRWIND 10, 1
IF ANS$ <> "Y" THEN GOTO OVER
GOTO DISKINST
ELSE 'DIRECTORY ENTRIES EXISTED
RTRN$ = "A"
MAKEWIND 11, "", 6, 100, 16, 7, 112, 11
HIATTR% = 0: RTRN% = 0
' MAKE ACTIVE WINDOW (11) A SCROLL WINDOW, PLACING THE LIST OF
' FOUND FILES IN SAME. INFOFIXED PLACES THE INSTUCTIONS IN THE
' INFOLINE.
INFOFIXED " Select a file with scroll bar and press ENTER."
SCRLWIND DIREC$(), DUMMY$(), "", F%, RTRN$, RTRN%, 1, 1, RKEY%, HIATTR%
INFOFIXED ""
END IF
RTRN$ = DIREC$(RTRN%)
IF RKEY% = 27 THEN RSTRWIND 11, 1: RSTRWIND 10, 1: GOTO OVER 'ESC EXITS
' SET WINDOW 13'S TITLE BASE ON SELECTED FILES ATTRIBUTES
' PRINT FILES SPECS IN THE WINDOW. CALL GETANS TO SEE IF ANOTHER
' DIRECTORY SEARCH IS REQUESTED.
FATTR% = DIRINFO(RTRN%).ATTR
T$ = "File: ": IF FATTR% = 8 THEN T$ = "Volumn: " ELSE IF FATTR% = 16 THEN T$ = "Directory: "
MAKEWIND 13, " " + T$ + RTRN$, 14, 100, 44, 7, 112, 112
PRINTW "SIZE:" + STR$(DIRINFO(RTRN%).SIZE) + " bytes", 1, 15
PRINTW "DATE: " + DIRINFO(RTRN%).DATE, 2, 15
PRINTW "TIME: " + DIRINFO(RTRN%).TIME, 3, 15
ANS$ = ""
GETANS "[ Repeat directory search (Y/N)? ]", "YN", ANS$, 20, 100, 143, 0
DONEDIR:
RSTRWIND 13, 1 ' RESTORE ALL WINDOWS
RSTRWIND 11, 1
RSTRWIND 10, 1
IF ANS$ <> "Y" OR RK% = 27 THEN GOTO OVER ' "Y" = REPEAT SEARCH.
GOTO DISKINST
OVER:
ERASE DIREC$ ' GET MEMORY BACK.
ON ERROR GOTO 0
'------------------------- "COLOR" OPTION FROM MENUBAR ---------------------
CASE 5
CALL COLORDEMO(WIND%) ' CHANGE COLOR DEMO
GOTO PREINTRO ' GOING HERE REPAINTS THE SCREEN.
'------------------------ SOUND = CLICK OR BEEP OR OFF --------------------
CASE 6
CALL SOUNDDEMO(WIND%)
'-------------------------------- ORDER FORM -------------------------------
CASE 7
RSTRINFO 0
A% = COL%(23): IF A% = 15 THEN A% = 112
TOFLD% = 1: FROMFLD% = 0
MAKEWIND 1, "@[ F1 = ABORT ] *** WINDOWS R-E-Z Order Form *** [ F10 = Print ]", 100, 100, 80, 25, A%, 101
PRINTW "Name....... Date.....", 2, 2
PRINTW "Address.... Registered User (Y/N).", 4, 2
PRINTW "Address.... Registration Number..", 6, 2
PRINTW "City/State.", 8, 2
PRINTW "Zip Code... ( Enter 0 if not USA )", 10, 2
PRINTW "Programming Language.. Disk Size............", 12, 2
PRINTW "Hard Copy Documentation (Y/N). ( Same as on disk. Lazer printed. Three ) ", 14, 2
PRINTW "( ring binder - $15.00 - USA orders only.)", 15, 36
PRINTW "TERMS: Check/ money order/ Visa/ MC. Fees detailed on hard copy order form.", 17, 2
PRINTW "Visa / Master card # Expiration date:", 19, 2
NEWCOLOR 15
PREYN$ = ORDER$(7)
J$ = SPACE$(76)
PREORDER:
SELECT CASE TOFLD%
CASE 1
I$ = "Input your name."
CASE 2, 3, 4
I$ = "Input your address."
CASE 5
I$ = "Input your zip code."
CASE 6
I$ = "Enter today's date. (" + DATETYPE$(DFORMAT%) + ") Must be valid to exit field!"
CASE 7
I$ = "Input Y if you are a registered user or N if not."
CASE 8
I$ = "If you are a registered user input your registation number."
CASE 9
I$ = "CHOICES: QuickBASIC 4.5/Quickbasic 4.00/.00b/BASIC 7.0 - PDS/BASIC 7.1 - PDS"
GOSUB SPINST
CASE 10
I$ = "CHOICES: 5.25 inch - 360k / 3.5 inch - 720k"
GOSUB SPINST
CASE 11
I$ = "Enter Y for hard copy documentation or N for none."
CASE 12
I$ = "Enter Visa/Master Card number if using same."
CASE 13
I$ = "Enter Visa/Master card expiration date. ( mm/yy )"
CASE ELSE
END SELECT
IF TOFLD% < 9 OR TOFLD% > 11 THEN I$ = "INSTRUCTIONS: " + I$
LSET J$ = I$
PRINTW J$, 21, 100
MULTINPT 4, TOFLD%, EXIT$, FROMFLD%, RKEY%, ORDER$()
IF RKEY% = 32 THEN ' Space bar - fields 9,10,11
SELECT CASE FROMFLD%
CASE 9 ' Space bar - field 10
LAN% = LAN% + 1: IF LAN% = 5 THEN LAN% = 1
ORDER$(9) = LAN$(LAN%) ' change language
CASE 10 ' Space bar - field 11
DSIZE% = DSIZE% + 1: IF DSIZE% = 3 THEN DSIZE% = 1
ORDER$(10) = DISK$(DSIZE%) ' change disk type
CASE ELSE
END SELECT
GOTO PREORDER
END IF
' Delete the space bar instruction window if the field is not a
' "multi-choice field or MULTINPT is exited via a function key.
' ( EXIT$ <> "AUTO" )
IF FROMFLD% >= 9 AND FROMFLD% <= 10 THEN
IF TOFLD% < 9 OR TOFLD% > 10 OR RKEY% < 11 THEN
RSTRWIND 3, 1
END IF
END IF
IF RKEY% > 10 THEN ' Was not a F1 or F10 as EXIT$ = "AUTO".
GOTO PREORDER ' FROMFLD% can't = 0 so single field
END IF ' only will update ( for speed ).
' Program can get here if cursor movement
' key is pressed on fixed-choice field or
' any other field
IF RKEY% = 10 THEN ' F10 key was pressed to exit MULTINPT
FERR% = 0
FOR XX% = 1 TO 14 ' check for blank fields
SELECT CASE XX%
CASE 1, 4, 5, 6, 7, 11 ' fields require entry
IF ORDER$(XX%) = "" THEN
FERR% = 1
EXIT FOR
END IF
CASE 8 ' field 8 requireS entry if field 7 = "Y"
IF ORDER$(7) = "Y" AND ORDER$(XX%) = "" THEN
FERR% = 1
EXIT FOR
ELSE
IF ORDER$(7) = "N" AND ORDER$(XX%) <> "" THEN
FERR% = 2
EXIT FOR
END IF
END IF
CASE 13 ' field 14 requires entry if field 13 has entry
IF ORDER$(12) <> "" AND ORDER$(13) = "" THEN
FERR% = 1
EXIT FOR
END IF
CASE ELSE
END SELECT
NEXT
IF FERR% = 1 THEN ' a blank field was found
GETANS "BLANK FIELD: Entry required. Press any key...", "", "", 100, 100, 112, 11
TOFLD% = XX%: FROMFLD% = 1: GOTO PREORDER
ELSEIF FERR% = 2 THEN
GETANS "Field must be blank if Registered user field = N. Press any key...", "", "", 100, 100, 112, 11
TOFLD% = XX%: FROMFLD% = 1: GOTO PREORDER
END IF
OANS$ = ""
GETANS "Prepare your printer. Press any key when ready...", "", OANS$, 18, 100, 143, 2
IF OANS$ = CHR$(27) THEN GOTO PREORDER
ON ERROR GOTO PRINTERROR
LPRINT
LI$ = STRING$(76, "-")
LPRINT
LPRINT TAB(4); LI$
LPRINT TAB(28); "WINDOWS R-E-Z ORDER FORM"
LPRINT TAB(34); "Version 5.10"
LPRINT TAB(4); LI$
LPRINT
FOR P% = 1 TO 4
LPRINT " " + ORDER$(P%);
IF P% = 1 THEN LPRINT TAB(53); "Date: " + ORDER$(6);
IF P% = 2 THEN LPRINT TAB(53); "Registered User: " + ORDER$(7);
IF P% = 3 THEN LPRINT TAB(53); "Registration Number: " + ORDER$(8)
IF P% = 4 THEN
LPRINT " " + ORDER$(5);
ELSE
LPRINT : LPRINT
END IF
NEXT
LPRINT
LPRINT TAB(4); LI$
LPRINT
LPRINT " Programming Language: " + ORDER$(9)
LPRINT
LPRINT " Disk Size: " + ORDER$(10)
LPRINT
LPRINT TAB(4); LI$
LPRINT
LPRINT " Visa / Master card # " + ORDER$(12); TAB(55); "Expiration Date: " + ORDER$(13)
LPRINT
LPRINT " Signature:"
LPRINT " -----------------------------------"
LPRINT TAB(4); LI$
LPRINT
LPRINT TAB(35); "Registration / Update fee: -------- ";
IF ORDER$(7) = "N" THEN
FEE$ = "$30.00": FEE = 30
ELSE
FEE$ = "$20.00": FEE = 20
END IF
LPRINT FEE$
LPRINT
LPRINT TAB(35); "Hard copy documentation charge ---- ";
IF ORDER$(11) = "Y" THEN
FEE$ = "$15.00": FEE = FEE + 15
ELSE
FEE$ = ""
END IF
LPRINT FEE$
LPRINT
LPRINT TAB(35); "Shipping and Handling-------------- $2.50"
LPRINT
FEE$ = STR$(FEE + 2.5): MID$(FEE$, 1) = "$"
LPRINT TAB(35); " TOTAL CHARGE --------- ";
LPRINT USING "$##.##"; FEE + 2.5
LPRINT
LPRINT TAB(4); LI$
LPRINT
LPRINT " Make checks and money orders payable to: CONNECT Software"
LPRINT
LPRINT " Send completed order form to: CONNECT Software"
LPRINT TAB(37); "6192 Fawn Meadow"
LPRINT TAB(37); "Farmington, NY 14425"
LPRINT
LPRINT
LPRINT " Orders paid with a credit card or money order will be shipped within "
LPRINT " two weeks of receipt. Orders paid with checks will be shipped within"
LPRINT " three weeks of receipt."
LPRINT
LPRINT " Phone Orders - 6:OOpm - 9:00pm EST Weekdays and weekends."
LPRINT " - (716) 924-3439"
LPRINT
LPRINT " Call person to person for RICH - CONNECT SOFTWARE"
LPRINT TAB(4); LI$
LPRINT CHR$(12)
DONEORDER:
ON ERROR GOTO 0
END IF
RSTRWIND 1, 1 ' It was a function key
CASE ELSE
END SELECT
GOTO MAIN.MENU
PRINTERROR:
OANS$ = ""
GETANS "PRINTER ERROR: (R)etry or (A)bort.", "RA", OANS$, 100, 100, 143, 2
IF OANS$ = "R" THEN RESUME ELSE RESUME DONEORDER
SPINST:
IF WAVAIL%(3) THEN
MAKEWIND 3, "", 18, 100, 75, 3, 240, 1
NEWCOLOR 15
PRINTW "Press SPACE BAR for selection. Press cursor movement key to exit field.", 1, 100
CHNGWIND 1
END IF
RETURN
DISKERROR:
IF PREFLAG% = 1 THEN PATH$ = CURRDISK$
SELECT CASE ERR
CASE 75, 76
E$ = "PATH NOT FOUND"
CASE 71
E$ = "DRIVE NOT READY"
CASE 72
E$ = "DISK MEDIA ERROR"
CASE 57
E$ = "I/O ERROR"
CASE 68
E$ = "DRIVE NOT AVAILABLE"
CASE ELSE
E$ = "UNIDENTIFIED ERROR"
END SELECT
A% = A% + 128
GETANS "DRIVE " + LEFT$(PATH$, 2) + ". " + E$ + ". Press any key...", "", "", 19, 100, A%, 11
A% = A% - 128
IF PREFLAG% = 1 THEN RESUME REALSTART
RSTRWIND 10, 1
RESUME DISKINST
FUNCTION COL% (A%)
' DEMOATTR% IS SHARED
' DEMOATTR% = 112 IF BLACK AND WHITE OR NO HIGH INTENSITY
IF DEMOATTR% = 112 THEN COL% = 15 ELSE COL% = A%
END FUNCTION
SUB COLORDEMO (WIND%)
' DEMOATTR%, NOHI% AND SHADCOL% ARE SHARED VARIABLES.
RSTRINFO 1 ' RESTORE AREA UNDER AND
' DEACTIVATE THE INFO-LINE.
DEMOATTR% = 112 ' DEFAULT B/W.
NOHI% = 0 ' DEFAULT IS HI-INTENSITY.
SHADCOL% = 7 ' DEFAULT SHADOW COLOR SET TO 7.
IF WIND% = 2 THEN ' COLOR WAS SELECTED.
DEMOATTR% = 0 ' FLAG FOR COLOR.
SHADCOL% = 8 ' SHADOW SET FOR COLOR.
ELSEIF WIND% = 3 THEN ' NO HI INTENSITY WAS SELECTED.
NOHI% = 1 ' SET NO HI-INTENSITY FLAG.
END IF
CALL SETPARAMETERS ' USES SHARED VARIABLES NOHI%,
' SHADCOL% AND DEMOATTR%,
END SUB
SUB INPUTWINDOWDEMO
RSTRINFO 0 ' RESTORE AREA UNDER INFOLINE & KEEP IT ACTIVE.
A% = COL%(32) ' GREEN/GRAY OR B/W
IF A% = 32 THEN AADD% = 1000 ELSE AADD% = 0 ' AADD% ALLOWS HI-INTENSITY
' USE WINDOW 15 TO DESCRIBE INPUT WINDOWS. GETANS WAITS FOR ANY KEY.
MAKEWIND 15, "@*** Input Window Demonstration ***", 3, 4, 70, 6, A%, 112
PRINTW "An input window can be used to prompt for, and receive, input. The", 1, 2
PRINTW "area under the window is automatically saved and restored on exit.", 2, 2
GETANS "Press any key.......", "", "", 13, 100, A% + 128, 11
RSTRWIND 15, 1 ' RESTORE AREA UNDER WINDOW 15.
' MAKE A "NEW" WINDOW 15 AND USE FOR INSTRUCTIONS.
MAKEWIND 15, "@[ Input Window Instructions ]", 3, 100, 72, 9, A%, 12
PRINTW "SPACE BAR/ CTRL E Erases field if first key pressed./ Erases field.", 1, 2
PRINTW "ENTER Exits the procedure. ( Returns the string )", 2, 2
PRINTW "BACKSPACE/ DELETE Erase character to left of or under cursor.", 3, 2
PRINTW "LEFT/ RIGHT ARROW Moves cursor from start to end of input text.", 4, 2
PRINTW "INSERT Toggle between insert and overstrike mode.", 5, 2
PRINTW "ESC Returns field to pre-edited state, and exits.", 6, 2
PRINTW "HOME/ END Move cursor to start or end of text.", 7, 2
START.EDIT:
' USE GETANS TO SET P$ TO REPRESENT THE CASE FOR ALPHA/NUMERIC INPUT.
PRINTINFO " Press <U> for upper case - <L> for lower case - <B> for both."
P$ = ""
GETANS "", "ULB", P$, 21, 100, 0, 0
IF P$ = CHR$(27) THEN GOTO DONEIWIND ' ESC EXITS
IF P$ = "B" THEN P$ = "A" ' B = BOTH CASES. CHANGE TO
' A FOR REGULAR ALPHA/NUM.
'GET ALPHA/NUMERIC INPUT FROM ROUTINE INPTWIND.
PRINTINFO " Prompts can be printed in the window's title box. Press ENTER to finalize."
INPTWIND "@** Input Your Name **", P$, 14, 100, 30, A% + AADD%, "", RTR$, RK%, 112
RSTRINPT 1 ' RESTORE THE INPUT WINDOW
IF RK% = 27 THEN GOTO DONEIWIND ' ESC EXITS
' DATE INPUT. DATETYPE$(DFORMAT%) IS SHARED VARIABLE WHICH SPECIFIES
' DATE FORMAT.
PRINTINFO " " + I$ + "Prompts can be printed the left of the field in the window."
INPTWIND "DATE MUST = " + DATETYPE$(DFORMAT%) + " ( 1901 to 2099 ) to exit. ", "D", 15, 100, 10, A% + AADD%, "", RTR2$, RK%, 11
RSTRINPT 1 ' RESTORE INPUT WINDOW
IF RK% = 27 THEN GOTO DONEIWIND ' ESC EXITS
' GET NUMBER OF DECIMAL PLACES IN DEC$ FOR NEXT CALL TO INPTWIND.
PRINTINFO " Enter number of decimal places to return for next input Window ( 0-6 )"
DEC$ = ""
GETANS "", "0123456", DEC$, 21, 100, A%, 0
IF DEC$ = CHR$(27) THEN GOTO DONEIWIND ' ESC EXITS
' NUMERIC INPUT WITH NO WINDOW.
PRINTINFO " LOOK - no window! The number with " + DEC$ + " decimals must fit to exit the field."
IF A% = 15 THEN ADD% = 97 ELSE ADD% = 0 ' COLOR
INPTWIND "INPUT A NUMBER: ", DEC$, 15, 100, 15, A% + AADD% + ADD% + 1000, "", RTR1$, RK%, 0
RSTRINPT 1 ' RESTORE INPUT WINDOW
IF RK% = 27 THEN GOTO DONEIWIND ' ESC EXITS
' DISPLAY ENTERED DATA IN WINDOW 2.
MAKEWIND 2, "@**** The Data Entered Was:****", 14, 100, 41, 5, A%, 12
PRINTW "NAME: " + RTR$, 1, 2
PRINTW "DATE: " + RTR2$, 2, 2
PRINTW "NUMBER: " + RTR1$, 3, 2
' RESTORE AREA UNDER INFOLINE AND USE CALL TO GETANS TO REPEAT OR EXIT.
RSTRINFO 0
ANS$ = ""
GETANS "Press (E) to Edit Data or (R) to Return to Main Menu.", "RE", ANS$, 21, 100, A% + 128, 11
RSTRWIND 2, 1
IF ANS$ = "E" THEN GOTO START.EDIT
DONEIWIND:
RSTRWIND 15, 1 ' RESTORE WINDOW 15 (INSTRUCTIONS).
END SUB
SUB MULTINPUTDEMO1
' MAKES TWO MULTI-FIELD INPUT SCREENS. THE DATA FOR THE FIELDS IN THE
' SCREENS USES ARRAY MRTRN1$() FOR SCREEN 1 AND MRTRN2$() FOR SCREEN 2.
' THESE ARRAYS ARE SHARED AND WERE INITIALIZED VIA THE MODULE LEVEL
' CODE. THE FIELD DATA FOR BOTH INPUT SCREENS WAS ALSO INITIALIZED
' AT MODULE LEVEL.
STATIC THISDATE% ' USED TO DETERMINE IF DATE FORMAT HAS CHANGED
' SINCE THIS SUB WAS CALLED LAST.
RSTRINFO 0 ' RESTORE AREA UNDER INFOLINE
A% = COL(71): IF A% = 15 THEN A% = 112 ' COLOR RED/GRAY OR B/W
' MAKEWINDOW 15 AND PRINT INFO IN SAME. USE GETANS TO WAIT FOR ANY KEY.
MAKEWIND 15, "@***** Multi-field Input Demonstration *****", 4, 4, 74, 7, A%, 112
PRINTW " Up to ten multi-field input screens may be defined using up to", 1, 2
PRINTW "150 input fields per screen. Fields may be set to alpha/numeric num-", 2, 2
PRINTW "eric, date, or protected. Complete editing features are incorporated.", 3, 2
ANS$ = ""
GETANS "Press any key.......", "", ANS$, 13, 100, A% + 128, 11
RSTRWIND 15, 1 ' RESTORE WINDOW 15.
IF ANS$ = CHR$(27) THEN GOTO ALLDONE ' ESC EXITS
' MAKE AND PRINT IN THE INPUT SCREEN. DFORMAT% IS SHARED VARIABLE
' WHICH REPRESENTS DATE FORMAT. THISDATE% IS STATIC & LOCAL TO THIS
' SUB. MRTRN2$(5) IS THE DATE FIELD FOR THE SECOND INPUT SCREEN.
' IF THISDATE% <> DFORMAT% THIS IS THE FIRST CALL TO THIS SUB OR THE
' DATE FORMAT HAS CHANGED. IN EITHER CASE SET THE DATE FIELD TO "".
MAKEWIND 15, "@F1 - Next Input Screen F2 - Main Menu F10 - Help", 1, 1, 80, 25, A%, 102
IF THISDATE% <> DFORMAT% THEN MRTRN2$(5) = ""
THISDATE% = DFORMAT%
SCRN% = 1 ' START ON INPUT SCREEN 1
TOFLD1% = 1 ' START IN FIELD 1 ON INPUT SCREEN 1
TOFLD2% = 1 ' START IN FIELD 1 ON INPUT SCREEN 2
MAKEINPT:
FROMFLD% = 0 ' UPDATE ALL FIELDS - SCREEN 1 AND 2
IF SCRN% = 1 THEN ' THIS IS SCREEN 1.
CALL INPTINIT(DFORMAT%, 1, "") ' SET DATE FORMAT/DECIMAL POINT = "."
CLRWIND ' CLEAR WINDOW'S INTERIOR
PRINTW "**** FIXED CHOICE FIELDS ****", 1, 48
PRINTW "****** Press SPACE BAR ******.", 2, 48
PRINTW "Decimal(0) Decimal(1) Decimal(2)", 2, 4
PRINTW "Color...", 3, 48
PRINTW "( Padded with leading zeros.) Location.", 5, 14
PRINTW "Alpha/num. Upper case Alpha/num. Lower case Alpha/numeric", 7, 4
PRINTW "*** Auto-advance fields -- Cursor moves to the next field automatically ***", 10, 100
PRINTW "(-- Restricted Input --)", 12, 14
PRINTW "M or F: Y or N: SOC SECURITY #.. - -", 13, 100
PRINTW "* Auto-exit ( On change only ) and Auto-advance fields. (A,B ) *", 15, 100
PRINTW "* Single field update on protected field C allows fast exit and return *", 16, 100
PRINTW "[ PRESS F1 FOR MORE AUTO-EXIT EXAMPLES.]", 20, 100
PRINTW "A +B =C", 18, 20
PRINTW "If formatted number won't fit, field and input screen cannot be exited.", 21, 4
MAKE1:
' GET INPUT FROM SCREEN 1
MULTINPT 1, TOFLD1%, "EXIT$", FROMFLD%, RKEY%, MRTRN1$()
' FROMFLD% IS THE FIELD THE CURSOR IS LEAVING OR THE FIELD THE
' CURSOR IS ON WHEN MULTINPT IS "AUTOEXITED".
SELECT CASE FROMFLD% ' "EXIT FROM" FIELD
CASE 5, 6 ' 5 OR 6.
IF RKEY% = 32 THEN ' EXIT VIA THE SPACE BAR.
' SPACE BAR - FIELD 5. COLCHOICE$() IS SHARED FROM MODULE
' LEVEL CODE. IF SPACE BAR IS PRESSED ON FIELD 5 THE TEXT
' IN THE FIELD IS CHANGED TO THE NEXT ELEMENT OF COLCHOICE%.
' AS FROMFLD% EQUALS THE FIELD THE CURSOR WAS IN WHEN THE
' SPACE BAR WAS PRESSED ONLY THAT FIELD WILL BE UPDATED
' WHEN MULTINPT IS RE-ENTERED.
IF FROMFLD% = 5 THEN
COLCHOICE% = COLCHOICE% + 1
IF COLCHOICE% = 5 THEN COLCHOICE% = 1 ' ROLLOVER TO 1
MRTRN1$(5) = COLCHOICE$(COLCHOICE%)
' SAME AS FOR FIELD 5 USING SHARED ARRAY LOCHOICE$().
ELSE ' SPACE BAR - FIELD 6
LOCHOICE% = LOCHOICE% + 1
IF LOCHOICE% = 5 THEN LOCHOICE% = 1
MRTRN1$(6) = LOCHOICE$(LOCHOICE%)
END IF
END IF
CASE 15, 16
' EXIT FROM FIELD 15 OR 16. THESE FIELDS ARE "EXIT ON CHANGE"
' FIELDS. IF THEY ARE CHANGED ADD THE VALUE OF BOTH FIELDS AND
' PUT IN FIELD 17. SETTING FROMFLD% TO 17 SIGNALS MULTINPT
' TO UPDATE FIELD 17 ONLY, WHEN IT IS RE-ENTERED.
MRTRN1$(17) = STR$(VAL(MRTRN1$(15)) + VAL(MRTRN1$(16)))
IF MRTRN1$(15) + MRTRN1$(16) = "" THEN MRTRN1$(17) = ""
FROMFLD% = 17 ' ONLY UPDATE FIELD 17
CASE ELSE
END SELECT
IF RKEY% = 10 THEN GOSUB HELP: GOTO MAKE1 ' WAS F10. GO SUB HELP.
' WAS NOT F1 OR F2. MUST HAVE BEEN AN "AUTOEXIT" FIELD. IT COULD
' HAVE BEEN FIELD 5, 6, 15 OR 16. GOING BACK TO MAKE1 CALLS MULTINPT
' FOR SCREEN 1 AGAIN. FROMFLD% SPECIFIES WHICH FIELD TO UPDATE.
' TOFLD1% IS AUTOMATICALLY SET TO POINT TO THE CORRECT ACTIVE FIELD
' UPON ENTRY TO MULTINPT. ( TOFLD1% IS SET BY MULTINPT BEFORE IT IS
' EXITED. )
IF RKEY% > 12 THEN GOTO MAKE1
END IF
' MAKE AND PRINT THE SECOND INPUT SCREEN. INPTINIT SETS THE DECIMAL
' DESIGNATOR TO A COMMA AS THE SECOND ARGUMENT = 0.
IF SCRN% = 2 THEN
INPTINIT DFORMAT%, 0, ""
CLRWIND
PRINTW "*** ---------- All fields are Auto-exit ( Always ) fields.---------- ***", 2, 100
PRINTW "*** The instruction line is made possible by using Auto-exit fields. ***", 3, 100
LINEW 4, 1
LINEW 11, 1
PRINTW "NAME..............", 6, 5
PRINTW "ADDRESS...........", 7, 5
PRINTW "CITY/STATE/ZIP....", 8, 5
PRINTW "DATE...(" + DATETYPE$(DFORMAT%) + ")..", 10, 5
PRINTW "Decimal 1 Decimal 2 Decimal 3", 12, 35
PRINTW "Comma as decimal ( non-USA ):", 13, 5
LINEW 14, 1
PRINTW "* This example sets the active field to a different color than the inactive *", 16, 1
PRINTW "* fields allowing the fields to be placed on consecutive rows without blend- *", 17, 1
PRINTW "* ing into each other. The user's attention is drawn to the active field. *", 18, 1
LINEW 20, 1
INSTRUCT$ = SPACE$(76)
MAKE2: ' SET I$ TO THE INSTRUCTIONS FOR
SELECT CASE TOFLD2% ' THE NEXT FIELD TO BE ENTERED.
CASE 1
I$ = "INPUT YOUR NAME"
CASE 2
I$ = "INPUT YOUR STREET ADDRESS"
CASE 3
I$ = "INPUT YOUR CITY AND STATE"
CASE 4
I$ = "INPUT YOUR ZIP CODE"
CASE 5
I$ = "VALID DATE (" + DATETYPE$(DFORMAT%) + ") 1901 TO 2099 REQUIRED TO EXIT FIELD!"
CASE 6, 7, 8
I$ = "FIELD CAN NOT BE EXITED IF FORMATED NUMBER WILL NOT FIT!"
CASE ELSE
END SELECT
LSET INSTRUCT$ = "INSTRUCTIONS: " + I$ ' MAKE INSTRUCT$
NEWCOLOR 15 ' BLACK/HI-INTENSITY WHITE
PRINTW INSTRUCT$, 21, 2 ' PRINT INSTRUCTIONS.
NEWCOLOR A% ' RESTORE ORIGINAL COLOR.
' GET INPUT FROM MULT-FIELD INPUT SCREEN 2. AS FROMFLD% = 0 THE
' FIRST TIME MULTINPT IS ENTERED ALL FIELDS WILL UPDATE.
MULTINPT 2, TOFLD2%, EXIT$, FROMFLD%, RKEY%, MRTRN2$()
FROMFLD% = 1 ' ONLY UPDATE FIELD 1 FOR SPEED THE NEXT
' TIME MULTINPT IS ENTERED.
IF RKEY% = 10 THEN GOSUB HELP: GOTO MAKE2 ' WAS F10. GO SUB HELP
IF RKEY% > 12 THEN GOTO MAKE2 ' WAS NOT F1 OR F2.
END IF
IF RKEY% = 1 THEN ' WAS F1.
IF SCRN% = 1 THEN ' TOGGLE TO SREEN 2 IF
SCRN% = 2 ' SCREEN 1 IS ACTIVE.
ELSE ' ELSE TOGGLE TO SCREEN 1.
LINEW 4, 0: LINEW 11, 0: LINEW 14, 0: LINEW 20, 0
SCRN% = 1
END IF
GOTO MAKEINPT ' GO BACK.
END IF
GOTO ALLDONE ' MUST BE F2 O EXIT.
' HELP = WINDOW 14. PRINT IN THE WINDOW AND USE GETANS TO WAIT FOR ANY KEY.
HELP:
MAKEWIND 14, "@***** Multi-field Input Instructions *****", 100, 100, 76, 14, 15, 101
PRINTW "Key(s): Function:", 1, 2
PRINTW "CTRL END/ CTRL HOME Move to first or last field.", 1, 2
PRINTW "TAB/ SHIFT TAB Move from field to field horizontally.", 2, 2
PRINTW "UP/ DOWN ARROW /ENTER Move from field to field. ( user defined order )", 3, 2
PRINTW "BACKSPACE/ DELETE Erase character to left of or under cursor.", 4, 2
PRINTW "LEFT/ RIGHT ARROW Moves cursor from start to end of text.", 5, 2
PRINTW "INSERT Toggle between insert and overstrike mode.", 6, 2
PRINTW "ESC/ CTRL E Returns field to pre-edited state. / Erases field.", 7, 2
PRINTW "HOME/ END Moves cursor to start or end of text.", 8, 2
PRINTW "SPACE BAR Erases field if it this is the first key pressed.", 9, 2
GETANS "[ PRESS ANY KEY TO EXIT HELP ]", "", "", 19, 100, 240, 0
RSTRWIND 14, 1
CHNGWIND 15
RETURN
ALLDONE:
CALL INPTINIT(DFORMAT%, 1, "") ' SET DECIMAL DESIGNATOR TO A PERIOD.
RSTRWIND 15, 1 ' RESTORE AREA UNDER THE INPUT SCREEN.
END SUB
SUB MULTINPUTDEMO2
RSTRINFO 0 ' RESTORE AREA UNDER INFOOLINE
A% = COL%(23): IF A% = 15 THEN A% = 112 ' A%= COLOR -- B/W
' PRINT THE INPUT SCREEN IN WINDOW 15
MAKEWIND 15, "@Multi-field Input. Extensive use of fixed choice fields.", 1, 1, 80, 25, A%, 102
MAKEWIND 1, "@ Change ", 6, 100, 59, 15, 112, 11
LINEW 12, 1
PRINTW "Find What:", 2, 2
PRINTW "Change To:", 5, 2
PRINTW "[ ] Match Upper/Lowercase", 8, 2
PRINTW "[ ] Whole Word", 9, 2
PRINTW "< > < > < > < >", 13, 2
MAKEWIND 10, "@ Search ", 13, 43, 25, 5, 112, 1
PRINTW "( ) Active Window", 1, 2
PRINTW "( ) Current Module", 2, 2
PRINTW "( ) All Modules", 3, 2
MAKEWIND 11, "", 7, 25, 43, 3, 112, 1
MAKEWIND 12, "", 10, 25, 43, 3, 112, 1
CHNGWIND 15: NEWCOLOR 15
TOFLD% = 1 ' START IN FIELD ONE.
FROMFLD% = 0 ' UPDATE ALL FIELDS.
CHANGE:
' CURSOR TO FIELD 5 TO 7. THIS IS THE "SEARCH" SCOPE
IF TOFLD% > 4 AND TOFLD% < 8 THEN
TOFLD% = 5
WHILE CHNGRTRN$(TOFLD%) <> CHR$(4): TOFLD% = TOFLD% + 1: WEND
END IF
SELECT CASE TOFLD% ' PU INSTRUCTIONS IN A$
CASE 1, 2 ' ON ACTIVE (TOFLD%) FIELD.
A$ = "Input data."
CASE 3, 4
A$ = "Press SPACE BAR to change."
CASE 5, 6, 7
A$ = "Press UP/DOWN arrow keys to change."
CASE 8 TO 11
A$ = "Press SPACE BAR/ENTER to select."
CASE ELSE
END SELECT
A$ = A$ + " TAB = next field. ESC/ENTER exits."
PRINTW " " + A$ + SPACE$(76 - LEN(A$)), 21, 100 ' PRINT INSTRUCTIONS.
' GET MULTIFIELD INPUT. TOFLD% = THE ACTIVE FIELD ON ENTRY. FROMFLD%
' REPRESENTS THE FIELD WHICH IS ACTIVE ON EXIT
MULTINPT 3, TOFLD%, "U", FROMFLD%, RK%, CHNGRTRN$()
IF FROMFLD% > 4 AND FROMFLD% < 8 THEN ' Cursor from search window.
IF RK% = 16 OR RK% = 19 THEN ' Was UP or DOWN arrow.
IF TOFLD% = 4 THEN TOFLD% = 7 ' Keep cursor in the
IF TOFLD% = 8 THEN TOFLD% = 5 ' search window.
CHNGRTRN$(5) = "": CHNGRTRN$(6) = "": CHNGRTRN$(7) = ""
CHNGRTRN$(TOFLD%) = CHR$(4) ' Only one choice is permitted.
FROMFLD% = 0 ' Update all fields.
END IF
IF RK% = 14 THEN TOFLD% = 4 ' Was SHIFT TAB
IF RK% = 15 THEN TOFLD% = 8 ' Was TAB
END IF
SELECT CASE RK%
' RETURN CAUSED EXIT.
CASE 13
PICK$ = "ENTER"
IF FROMFLD% >= 7 THEN PICK$ = CHNGRTRN$(FROMFLD%)
GOTO PRINTRESULTS
' ESC CAUSED EXIT.
CASE 27
PICK$ = "ESC"
GOTO PRINTRESULTS
' SPACE BAR CAUSED EXIT.
CASE 32
IF FROMFLD% = 3 OR FROMFLD% = 4 THEN ' EXITING FIELD 3 OR 4
IF CHNGRTRN$(FROMFLD%) = "" THEN CHNGRTRN$(FROMFLD%) = "X" ELSE CHNGRTRN$(FROMFLD%) = ""
ELSEIF FROMFLD% > 7 THEN ' EXITING FIELD 8,9,10,11
PICK$ = CHNGRTRN$(FROMFLD%)
GOTO PRINTRESULTS
ELSE ' FIELD 5,6,7
'NOTHING
END IF
CASE ELSE
END SELECT
GOTO CHANGE
PRINTRESULTS:
' PRINT THE RESULTS IN WINDOW 1. GETANS WAITS FOR ANY KEY.
PRINTINFO ""
RSTRWIND 1, 1: RSTRWIND 2, 1: DELWIND 10: DELWIND 11: DELWIND 12
MAKEWIND 1, "@ Results ", 100, 100, 58, 13, 112, 111
PRINTW "Find What: = " + CHNGRTRN$(1), 2, 2
PRINTW "Change To: = " + CHNGRTRN$(2), 3, 2
IF CHNGRTRN$(3) = "" THEN S$ = "No" ELSE S$ = "Yes"
PRINTW "Match Upper/Lowercase = " + S$, 4, 2
IF CHNGRTRN$(4) = "" THEN S$ = "No" ELSE S$ = "Yes"
PRINTW "Whole Word = " + S$, 5, 2
IF CHNGRTRN$(5) = CHR$(4) THEN
S$ = "Active Window"
ELSEIF CHNGRTRN$(6) = CHR$(4) THEN
S$ = "Current Module"
ELSE
S$ = "All Modules"
END IF
PRINTW "Search Criteria = " + S$, 6, 2
PRINTW "Exit was via ...." + PICK$, 8, 2
GETANS "[ Press any key ]", "", "", 19, 100, 143, 0
' DELETE WINDOW 1. NO NEED TO RESTORE SAME AS IT RESIDED ON TOP OF
' WINDOW 15. RESTORING WINDOW 15 RESTORES THE SCREEN TO IT'S
' STATE BEFORE THIS SUB WAS CALLED.
DELWIND 1
RSTRWIND 15, 1
END SUB
SUB PRINTSPEED (WIND%)
RSTRINFO 0 ' RESTORE AREA UNDER INFO-LINE.
A% = COL%(113) ' COLOR PURPLE/GRAY OR B/W.
' MAKE WINDOW #1
MAKEWIND 1, "", 100, 100, 67, 6, A%, 12
LINEW 2, 1
IF WIND% = 3 THEN ' SLOW PRINT WAS SELECTED.
FAST% = 0 ' SHARED VARIABLE.
PRINTW "** Print speed is set to SLOW **", 1, 100
PRINTW "Windowing and print speed are set to fast. This may cause snow", 3, 2
PRINTW "or screen flicker if certain CGA display adaptors are used....", 4, 2
ELSE ' FAST PRINT WAS SELECTED.
FAST% = 1 ' SHARED VARIABLE.
PRINTW "** Print speed is set to FAST **", 1, 100
PRINTW "Windowing and print speed are set to slow if a CGA display ad-", 3, 2
PRINTW "aptor is present. This will eliminate screen snow or flicker.", 4, 2
END IF
' WAIT FOR ANY KEY. RESTORE AREA UNDER WINDOW #1. CALL SETPARAMETERS
' TO CHANGE PRINT SPEED AND ENABLE AND DISABLE PULLDOWN SELECTIONS.
A% = A% + 128
GETANS "Press any key.......", "", "", 15, 28, A%, 12
RSTRWIND 1, 1
CALL SETPARAMETERS ' USES SHARED VARIABLE, FAST% TO
' CHAGE PRINT SPEED.
END SUB
SUB SCROLLDEMO (WASESC%)
WASESC% = 0 ' WARNS CALLER ESC EXITED.
A% = COL%(113): IF A% = 15 THEN A% = 112 ' BLUE/WHITE OR B/W
' MAKE A SCROLL WINDOW TO SELECT THE TYPE OF SCROLL WINDOW.
CALL MAKEWIND(4, "", 5, 37, 38, 7, A%, 11)
SCROLLRTRN% = 1
' SAME INFO-LINE FOR ALL SELECTIONS.
INFOFIXED " Pick a scroll window!"
IF A% = 112 THEN HATTR% = 127 ELSE HATTR% = 124
CALL SCRLWIND(SUBSCROLL$(), DUMMY$(), "", 5, "A", SCROLLRTRN%, 1, 1, RKEY%, HATTR%)
INFOFIXED ""
RSTRWIND 4, 1 ' RESTORE SCROLL WINDOW.
IF RKEY% = 27 THEN WASESC% = 1: EXIT SUB ' ESC
RSTRWIND 2, 1 ' RESTORE CONNECT SOFTWARE WIND.
RSTRWIND 1, 1 ' RESTORE MAIN INSTRUCT. WIND.
RSTRPULL 1 ' RESTORE PULLDOWN WINDOW.
SELECT CASE SCROLLRTRN%
CASE 1 ' REGULAR SCROLL WINDOW PICKED
OPT$ = "REGULAR SCROLL WINDOW"
CASE 2 ' AUTO-EXIT PICKED
KIND$ = "A"
OPT$ = "AUTO-EXIT SCROLL WINDOW"
CASE 3 ' MARK PICKED
KIND$ = "M": MARK% = 1
OPT$ = "MARK SCROLL WINDOW"
CASE 4, 5 ' VIRTUAL OR LIST PICKED
' TITLE FOR VIRTUAL OR LIST SCROLL WINDOWS
TL$ = "NAME ADDRESS CITY ST. ZIP"
IF SCROLLRTRN% = 4 THEN TYP$ = "" ELSE TYP$ = "L"
CASE ELSE
END SELECT
' MAKE THE SCROLL WINDOW PICKED.
A% = COL(23): IF A% = 15 THEN HIATTR% = 15 ELSE HIATTR% = 31
MAKEWIND 2, "@" + OPT$, 4, 100, 40, 10, A%, 121
RTRN% = 0
IF A% = 15 THEN NEWCOLOR 7
IF SCROLLRTRN% = 4 OR SCROLLRTRN% = 5 THEN
' VIRTUAL OR LIST SCROLL WINDOW
IF TYP$ = "L" THEN
M$ = "[ ESC exits ]"
B4SCRL "E", "" ' ESC WILL EXIT SCRLWIND
ELSE
M$ = "[ ENTER or ESC exits ]"
END IF
PRINTW M$, 7, 100
INFOFIXED " LOOK! You may scroll UP, DOWN, LEFT and RIGHT. Try TAB or SHIFT/TAB also!"
SCRLWIND ADDRESS$(), DUMMY$(), TL$, 10, TYP$, RTRN%, 1, 1, RKEY%, 0
ELSE
' ALL OTHER SCROLL WINDOWS. KIND$ DEFINES THE TYPE.
INFOFIXED " Demonstration: " + OPT$ + ". Instuctions are in the scroll window!"
SCRLWIND SCROLL$(), DUMMY$(), "", 14, KIND$, RTRN%, 1, 1, RKEY%, HIATTR%
END IF
INFOFIXED ""
IF RKEY% = 27 GOTO DONESCROLL ' ESC
IF MARK% = 1 THEN ' WAS A MARK SCROLL WINDOW
TR% = 4: NR% = 18: TEXT$ = "@** THE MARKED ITEM(S) WERE: **"
RSTRWIND 2, 1
ELSE ' ALL EXCEPT MARK.
TR% = 17: NR% = 5: TEXT$ = "@The item selected was:"
END IF
' PRINT RESULTS
MAKEWIND 3, TEXT$, TR%, 100, 40, NR%, A%, 121
IF MARK% = 1 THEN ' PRINT "MARKED" SELECTIONS
IF KIND$ = "" THEN
PRINTW "NO ITEMS WERE MARKED!", 8, 100
ELSE
TR% = 1: START% = 1 ' START SEARCH AT POSITION 1
DO
B% = MARKED%(KIND$, START%) ' B%= MARKED ITEM # IN SCROLL$()
IF B% <> 0 THEN
S$ = SCROLL$(B%): GOSUB NEWSTR: PRINTW S$, TR%, 2
ELSE
EXIT DO
END IF
TR% = TR% + 1
LOOP
END IF
ELSE
S$ = SCROLL$(RTRN%): GOSUB NEWSTR
IF SCROLLRTRN% = 4 THEN S$ = RTRIM$(LEFT$(ADDRESS$(RTRN%), 22)) + "...."
PRINTW S$, 1, 100
END IF
GETANS "[ Press any key ]", "", "", 21, 100, 240, 0
RSTRWIND 3, 1
DONESCROLL:
RSTRWIND 2, 1
EXIT SUB
NEWSTR:
SA% = INSTR(S$, "@")
IF SA% THEN S$ = LEFT$(S$, SA% - 1) + MID$(S$, SA% + 1)
RETURN
END SUB
SUB SETDATEDEMO
' MAKE A SCROLL WINDOW. USE SHARED ARRAY DATETYPE$() FOR THE CHOICES.
' AS SHARED ARRAY DUMMY$ WAS DIMENSIONED TO 0, SAME INFO-LINE WILL
' PRINT FOR ALL SELECTIONS.
A% = COL%(23)
MAKEWIND 3, "@Format", 100, 100, 14, 9, A%, 112
PRETYPE% = DFORMAT%
INFOFIXED " DIRECTIONS: Select date format for input routines."
SCRLWIND DATETYPE$(), DUMMY$(), "", 5, "", DFORMAT%, DFORMAT%, 1, RKEY%, 0
INFOFIXED ""
RSTRWIND 3, 1 ' RESTORE THE SCROLL WINDOW AND
RSTRINFO 0 ' THE INFO-LINE.
IF RKEY% = 27 THEN ' ESC EXITED
DFORMAT% = PRETYPE%
ELSE
' DISPLAY SELECTION VIA GETANS.
' CALL INPTINIT TO CHANGE DATE FROMAT FOR INPUT ROUTINES.
GETANS "DATE FORMAT FOR INPUT ROUTINES IS: " + DATETYPE$(DFORMAT%) + " -- Press any key....", "", "", 100, 100, A%, 11
CALL INPTINIT(DFORMAT%, DECPOINT%, "")
END IF
END SUB
SUB SETPARAMETERS
SETWIND FAST%, SND%, SHADCOL%
SETSCRL SCROLLARROW%, NOHI%, 15
IF DEMOATTR% = 112 THEN A% = 112 ELSE A% = 120
' DISABLE OR DISABLE PULLDOWN SELECTION FOR FAST OR SLOW PRINT.
IF FAST% = 1 THEN W% = 4: W1% = 3 ELSE W% = 3: W1% = 4
CHNGPULL 3, W%, A% ' DISABLE
CHNGPULL 3, W1%, 0 ' ENABLE .
' DISABLE OR ENABLE PULLDOWN SELECTION FOR BEEP/CLICK/NO SOUND
IF SND% = 1 THEN W% = 2 ELSE IF SND% = 2 THEN W% = 1 ELSE W% = 3
FOR X% = 1 TO 3
IF X% = W% THEN B% = A% ELSE B% = 0
CHNGPULL 6, X%, B%
NEXT
' DISABLE OR ENABLE SELECTION FOR COLOR OR B/W
IF NOHI% = 1 THEN W% = 3 ELSE IF SHADCOL% = 8 THEN W% = 2 ELSE W% = 1
FOR X% = 1 TO 3
IF X% = W% THEN B% = A% ELSE B% = 0
CHNGPULL 5, X%, B%
NEXT
END SUB
SUB SOUNDDEMO (WIND%)
' SND% IS SHARED VARIABLE
RSTRINFO 0 ' RESTORE AREA UNDER INFO-LINE.
SELECT CASE WIND%
CASE 1 ' "BEEP" SELECTED FROM PULLDOWN WINDOW.
B$ = "BEEP": SND% = 2
CASE 2 ' "CLICK" SELECTED.
B$ = "CLICK": SND% = 1
CASE 3 ' "OFF" SELECTED
B$ = "OFF": SND% = 0
CASE ELSE
END SELECT
CALL SETPARAMETERS ' USES SHARED VARIABLE SND% TO SET SOUND.
A% = COL%(23) ' COLOR BLUE/GRAY OR B/W.
' PRINT MESSAGE AND WAIT FOR ANY KEY TO BE PRESSED
GETANS "The sound for all routines is set to " + B$ + ". Press any key.....", "", "", 100, 100, A%, 11
END SUB